home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / pbuild6 / procedur.bas < prev    next >
Encoding:
BASIC Source File  |  1999-01-13  |  1.8 KB  |  50 lines
  1. Attribute VB_Name = "mProcedureBuilder"
  2. Option Explicit
  3. Declare Function WritePrivateProfileString& Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal FileName$)
  4. '====================================================================
  5. 'this sub should be executed from the Immediate window
  6. 'in order to get this app added to the VBADDIN.INI file
  7. 'you must change the name in the 2nd argument to reflecty
  8. 'the correct name of your project
  9. '====================================================================
  10. Sub AddToINI()
  11.     Dim ErrCode As Long
  12.     ' Add the add-in into VBADDINI.INI
  13.     ErrCode = WritePrivateProfileString("Add-Ins32", "ProcedureBuilder.Connect", "0", _
  14.     "vbaddin.ini")
  15.     MsgBox "Add-in is now entered in VBADDIN.INI file."
  16.     ' Write me to the system registry for the first run
  17.     SaveSetting "Procedure Builder", "Author Details", "Author", "Mark Kirkland"
  18.     SaveSetting "Procedure Builder", "Author Details", "Organisation", "Brighton Health Care NHS Trust"
  19. End Sub
  20. Function NoSpaces(SearchString As String) As Boolean
  21.  
  22. ' Function searches a string for the space character and returns TRUE if no spaces are found
  23.  
  24. ' Error Handler
  25. On Error GoTo NoSpaces_Error
  26.  
  27. ' Declare variables
  28. Dim Counter As Integer  ' Loop counter
  29. Dim strTestChar As String
  30.  
  31. For Counter = 1 To Len(SearchString)
  32.     ' Search the string a character at a time
  33.     strTestChar = Mid$(SearchString, Counter, 1)
  34.     ' If a space character is found then return FALSE and exit the function
  35.     If strTestChar = " " Then
  36.         NoSpaces = False
  37.         Exit Function
  38.     End If
  39. Next Counter
  40.  
  41. ' No spaces were found so return TRUE
  42. NoSpaces = True
  43. Exit Function
  44.  
  45. ' Error Routine
  46. NoSpaces_Error:
  47. MsgBox "Error: " & Err.Number & " - " & Err.Description & "NoSpaces"
  48.  
  49. End Function
  50.